rm(list = ls(all = TRUE)) #clear workspace
setwd("~/REDISTRICTING/ALTERNATIVAS_APORCIONAMIENTO")

# Read files
con.est <- read.table("Censo_2010_con_estimacion.csv",
                      sep=";", row.names=1, skip=4, header=TRUE)[2:33,]
sin.est <- read.table("Censo_2010_sin_estimacion.csv",
                      sep=";", row.names=1, skip=4, header=TRUE)[2:33,]
ife <- read.table("IFE_NACIONAL_2012.txt",sep=";", row.names=2, header=TRUE)

# Check
cbind(row.names(con.est),row.names(sin.est),rownames(ife))
cbind(colnames(con.est),colnames(sin.est))
colnames(ife)

# Data
abbrev <- c('Ags','BC','BCS','Cam','Coah', 'Col', 'Chis',
            'Chih','DF','Dgo','Gto','Gro','Hgo','Jal',
            'Méx','Mich','Mor','Nay','NL','Oax','Pue',
            'Qro','QR','SLP','Sin','Son','Tab','Tamps',
            'Tlax','Ver','Yuc','Zac')
data <- data.frame(Total.con.est=con.est$Total,
                   Total.sin.est=sin.est$Total,
                   Mas.18.con.est=rowSums(con.est[,9:24]),
                   Mas.18.sin.est=rowSums(sin.est[,9:24]),
                   Lista.nominal=ife$LISTA.NOMINAL,
                   row.names=abbrev)
data

## Función que asigna
resto.mayor <- function(x, n=300, min=2) {
  # Media nacional por distrito
  media <- sum(x)/n
  # Distritos enteros
  enteros <- floor(x/media)
  # Asignacion directa de distritos
  directa <- rep(0,length(x))
  directa[enteros < min] <- min-enteros[enteros < min]
  # Asignacion por resto mayor
  por.asignar <- n-sum(enteros+directa)
  modulo <- x %% media
  modulo[directa > 0] <- 0 # con asignacion directa
  resto <- rep(0,length(x))
  resto[sort(modulo, decreasing=TRUE, index.return=TRUE)$ix[1:por.asignar]] <- 1
  # Return
  return(cbind(enteros,directa,resto, total=enteros+directa+resto))
}

## Asignación
out <- lapply(data, resto.mayor)
out

## Resultado
dist.2005 <- c(3, 8, 2, 2, 7, 2, 12, 9, 27, 4, 14, 9, 7, 19, 40, 12, 
               5, 3, 12, 11, 16, 4, 3, 7, 8, 7, 6, 8, 3, 21, 5, 4)
table <- data.frame(Distritos.2005=dist.2005,
                    sapply(out, function(x) x[,"total"]),
                    row.names=abbrev)
table

# DE
apply(table[,2:6],1,sd)

## Graph
pdf("Alternative_apportionment.pdf", 8, 19)
range <- range(table)
par(mfrow=c(1,2), bty="n")
dotchart(t(as.matrix(rev(table[1:16,]))), 
         pch=16, xlab="Curules", cex=0.9, xlim=range, gcolor="gray")
dotchart(t(as.matrix(rev(table[17:32,]))), 
         pch=16, xlab="Curules", cex=0.9, xlim=range, gcolor="gray")
dev.off()


